'*********************************************************************
'*  IDAutomation Barcode Font Formulas for Crystal Reports 4.01
'*  Copyright, IDAutomation.com, Inc. 2000-2004. All rights reserved.
'*
'*  You MUST use the fully functional Code 128 (dated 12/2000 or later)
'*  font for this code to create and print a proper barcode
'*
'*  To create UCC/EAN128 barcodes, use the appropriate
'*  ASCII 0202 and AIs included as documented at:
'*  http://www.idautomation.com/code128faq.html#EAN128andUCC128
'*
'*  You may incorporate our Source Code in your application
'*  only if you own a valid License from IDAutomation.com, Inc.
'*  for the associated font and the copyright notices are not
'*  removed from the source code.
'*
'*  Formula: Code128 - formats output to IDAutomationC128 fonts
'*  Tutorial: http://www.BizFonts.com/crystal/
'*********************************************************************
Dim DataToEncode As String
'Change the next line to connect to your data source; for example:
'DataToEncode = ({Table.Field})
DataToEncode = "81007123452112345678"

    Dim PrintableString As String
    Dim DataToFormat As String
    Dim WeightedTotal As Number
    Dim CurrentValue As Number
    Dim CheckDigitValue As Number
    Dim C128CheckDigit As String
    Dim StringLength As Number
    Dim I As Number
    Dim CurrentCharNum As Number
    Dim CurrentEncoding As String
    Dim C128Start As String
    Dim CorrectFNC As Number
    Dim CurrentChar As String
    CorrectFNC = 0
    PrintableString = ""
    DataToFormat = DataToEncode
    DataToEncode = ""
    'Here we select character set A, B or C for the START character
    StringLength = Len(DataToFormat)
    CurrentCharNum = Asc(Mid(DataToFormat, 1, 1))
    If CurrentCharNum < 32 Then C128Start = Chr(203)
    If CurrentCharNum > 31 And CurrentCharNum < 127 Then C128Start = Chr(204)
    If ((StringLength > 4) And IsNumeric(Mid(DataToFormat, 1, 4))) Then C128Start = Chr(205)
    '202 & 212-215 is for the FNC1, with this Start C is mandatory
    If CurrentCharNum = 202 Then C128Start = Chr(205)
    If CurrentCharNum = 212 Then C128Start = Chr(205)
    If CurrentCharNum = 213 Then C128Start = Chr(205)
    If CurrentCharNum = 214 Then C128Start = Chr(205)
    If CurrentCharNum = 215 Then C128Start = Chr(205)
    If C128Start = Chr(203) Then CurrentEncoding = "A"
    If C128Start = Chr(204) Then CurrentEncoding = "B"
    If C128Start = Chr(205) Then CurrentEncoding = "C"
    For I = 1 To StringLength
        'check for FNC1 in any set which is ASCII 202 and ASCII 212-215
        CurrentCharNum = Asc(Mid(DataToFormat, I, 1))
        If ((CurrentCharNum = 202) Or (CurrentCharNum = 212) Or (CurrentCharNum = 213) Or (CurrentCharNum = 214) Or (CurrentCharNum = 215)) Then
            DataToEncode = DataToEncode & Chr(202)
        'check for switching to character set C
        ElseIf ((I < StringLength - 2) And (IsNumeric(Mid(DataToFormat, I, 1))) And (IsNumeric(Mid(DataToFormat, I + 1, 1))) And (IsNumeric(Mid(DataToFormat, I, 4)))) Or ((I < StringLength) And (IsNumeric(Mid(DataToFormat, I, 1))) And (IsNumeric(Mid(DataToFormat, I + 1, 1))) And (CurrentEncoding = "C")) Then
        'switch to set C if not already in it
            If CurrentEncoding <> "C" Then DataToEncode = DataToEncode & Chr(199)
            CurrentEncoding = "C"
            CurrentChar = Mid(DataToFormat, I, 2)
            CurrentValue = Val(CurrentChar)
        'set the CurrentValue to the number of String CurrentChar
            If (CurrentValue < 95 And CurrentValue > 0) Then DataToEncode = DataToEncode & Chr(CurrentValue + 32)
            If CurrentValue > 94 Then DataToEncode = DataToEncode & Chr(CurrentValue + 100)
            If CurrentValue = 0 Then DataToEncode = DataToEncode & Chr(194)
            I = I + 1
        'check for switching to character set A
        ElseIf (I <= StringLength) And ((Asc(Mid(DataToFormat, I, 1)) < 31) Or ((CurrentEncoding = "A") And (Asc(Mid(DataToFormat, I, 1)) > 32 And (Asc(Mid(DataToFormat, I, 1))) < 96))) Then
        'switch to set A if not already in it
            If CurrentEncoding <> "A" Then DataToEncode = DataToEncode & Chr(201)
            CurrentEncoding = "A"
        'Get the ASCII value of the next character
            CurrentCharNum = Asc(Mid(DataToFormat, I, 1))
            If CurrentCharNum = 32 Then
                DataToEncode = DataToEncode & Chr(194)
            ElseIf CurrentCharNum < 32 Then
                DataToEncode = DataToEncode & Chr(CurrentCharNum + 96)
            ElseIf CurrentCharNum > 32 Then
                DataToEncode = DataToEncode & Chr(CurrentCharNum)
            End If
        'check for switching to character set B
        ElseIf (I <= StringLength) And (((Asc(Mid(DataToFormat, I, 1))) > 31) And ((Asc(Mid(DataToFormat, I, 1)))) < 127) Then
        'switch to set B if not already in it
            If CurrentEncoding <> "B" Then DataToEncode = DataToEncode & Chr(200)
            CurrentEncoding = "B"
        'Get the ASCII value of the next character
            CurrentCharNum = Asc(Mid(DataToFormat, I, 1))
            If CurrentCharNum = 32 Then
                DataToEncode = DataToEncode & Chr(194)
            Else
                DataToEncode = DataToEncode & Chr(CurrentCharNum)
            End If
        End If
    Next I
    
 
    '<<<< Calculate Modulo 103 Check Digit >>>>
    WeightedTotal = Asc(C128Start) - 100
    StringLength = Len(DataToEncode)
    For I = 1 To StringLength
        CurrentCharNum = Asc(Mid(DataToEncode, I, 1))
        If CurrentCharNum < 135 Then CurrentValue = CurrentCharNum - 32
        If CurrentCharNum > 134 Then CurrentValue = CurrentCharNum - 100
        If CurrentCharNum = 194 Then CurrentValue = 0
        CurrentValue = CurrentValue * I
        WeightedTotal = WeightedTotal + CurrentValue
        If CurrentCharNum = 32 Then CurrentCharNum = 194
        PrintableString = PrintableString & Chr(CurrentCharNum)
    Next I
    CheckDigitValue = (WeightedTotal Mod 103)
    If CheckDigitValue < 95 And CheckDigitValue > 0 Then C128CheckDigit = Chr(CheckDigitValue + 32)
    If CheckDigitValue > 94 Then C128CheckDigit = Chr(CheckDigitValue + 100)
    If CheckDigitValue = 0 Then C128CheckDigit = Chr(194)
    DataToEncode = ""
    Formula = C128Start & PrintableString & C128CheckDigit & Chr(206) & " "


